*
* $Id$
*
* $Log: moxsec.F,v $
* Revision 1.1.1.1  2002/07/24 15:56:27  rdm
* initial import into CVS
*
* Revision 1.1.1.1  2002/06/16 15:18:43  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:21  fca
* AliRoot sources
*
* Revision 1.1.1.1  1995/10/24 10:21:57  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
*-- Author :
      SUBROUTINE MOXSEC
C************************************************************
C
C  setup cross-section tables for MICAP
C
C  Called by: MORINI
C
C  INPUT: MICAP element IDs in KE  = LD(LFP11)
C         element densities in RHO = D (LFP12)
C
C  Author : C.Zeitnitz
C
C  See USER's GUIDE TO MICAP ORNL/TM-10340
C  for details and pointer description (MPOINT)
C
C************************************************************
#include "geant321/mmicap.inc"
#include "geant321/minput.inc"
#include "geant321/mpoint.inc"
#include "geant321/mconst.inc"
#include "geant321/cmagic.inc"
C
      CHARACTER*80 XSFILE
      CHARACTER*70 CCOMM
      CHARACTER*11 CGEANT
      CHARACTER*4  MARK
      CHARACTER*20 MATNAM
      INTEGER INEL(134)
      LOGICAL NOHED,XSTOP
C
C       CALCULATE THE NUMBER OF ELEMENTS (NNUC)
C       AND GENERATE THE ISOTOPE NUMBER ARRAY (IN(NMIX))
      NWTOT = 0
      DO 10 I=1,NMIX
         LD(LFP17+I-1)=0
         LD(LFP16+I-1)=0
   10 CONTINUE
C       INITIALIZE THE NUMBER OF ELEMENTS (NNUC)
      NNUC=0
      DO 30 I=1,NMIX
         IF(LD(LFP16+I-1).GT.0)GO TO 30
         NNUC=NNUC+1
         LD(LFP16+I-1)=NNUC
         DO 20 J=I+1,NMIX
            IF(LD(LFP11+I-1).NE.LD(LFP11+J-1))GO TO 20
            LD(LFP16+J-1)=NNUC
   20    CONTINUE
   30 CONTINUE
C get number of isoptopes from xsection file(s)
      LT = LTEMP
      NII = 0
   40 CONTINUE
        NUNIT = IQ(LT+NTUNIT)
        READ(NUNIT,'(I10)') NIS
        NII = NII + NIS
        IQ(LT+NTMPNI) = NIS
        LT = LQ(LT)
      IF(LT.GT.0) GOTO 40
C allocate needed memory for x-section
      NW = 2*NII+13*NNUC+2*NNR*NNUC+4*NGR*NNUC+3*NQ*NNUC+26*MEDIA + 2
      NI = NII
      NWTOT = NWTOT + NW
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX1,0,2,'MOX1',0,0,NW,0,-1)
C       SET UP THE B CONTROL BLOCK LOCATION NUMBER ARRAY ICOM(NNUC)
C LFP170 points to length of x-section data
      LFP170 = LMOX1 + 2
      LFP18=LFP170+NNUC
      LFP18A=LFP18+NII
      LFP19=LFP18A+NII
      LFP20=LFP19+NMIX
C       SET UP THE ARRAY (IREC(NII))
      CALL XSECN1(NII,D(LFP11),D(LFP16),D(LFP17),
     +                D(LFP18),D(LFP18A),D(LFP170),D(LFP19),
     +                D(LFP20),D(LFP20),INEL)
C check if all isotopes have been found in the x-section file(s)
      XSTOP = .FALSE.
      DO 50  I=1,NMIX
        IF(LD(LFP19+I-1).EQ.0) THEN
         WRITE(IOUT,10100)LD(LFP19+I-1)
10000    FORMAT(' MICAP: Could not find x-section of element ',I8)
         XSTOP = .TRUE.
        ENDIF
   50 CONTINUE
      IF(XSTOP) THEN
        PRINT '('' CALOR : Neutron x-section not found ===> STOP '')'
        STOP
      ENDIF
      LFP21=LFP20+NNUC
C store xs accuracy at LFP210 (used for thinning  in XSECN3)
      LFP210 = LFP21 + NNUC
      LFP22=LFP210+NNUC
      LFP23=LFP22+NNUC
      LFP24=LFP23+NNUC
      LFP25=LFP24+NNUC
      LFP26=LFP25+NNUC
      LFP27=LFP26+NNR*NNUC
      LFP28=LFP27+NNR*NNUC
      LFP29=LFP28+NNUC
      LFP30=LFP29+NNUC
      LFP31=LFP30+NGR*NNUC
      LFP32=LFP31+NGR*NNUC
      LFP33=LFP32+MEDIA
      LFP34=LFP33+MEDIA
      LFP35=LFP34+NNUC
      LFP36=LFP35+3*NQ*NNUC
C       CLEAR THE STORAGE LOCATIONS FOR THE DICTIONARIES, ETC.
      CALL CLEAR(D,LFP20,LFP36-1)
C       ESTABLISH THE RANDOM WALK STORAGE LOCATIONS
      LFP41=LFP36
      LFP42=LFP41+2*NNUC
      LFP45=LFP42+24*MEDIA
      LFP46=LFP45+NGR*NNUC
      NW = 0
      DO 60 INUC=1,NNUC
         NW = NW + LD(LFP170+INUC-1)
   60 CONTINUE
      NW = NW + 2
      NWTOT = NWTOT + NW
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX2,0,2,'MOX2',0,0,NW,0,-1)
      LFP43 = LMOX2 + 2
      LAST = LFP43 - 1
      MAXD = LMOX2 + NW
C       PLACE THE MICROSCOPIC CROSS SECTION DATA INTO THE CORE
      CALL XSECN2(D(LFP17),D(LFP18),D(LFP18A),
     +            D(LFP20),D(LFP21),D(LFP210),D(LFP22),D(LFP23),
     +            D(LFP24),D(LFP25),D(LFP26),D(LFP27),D(LFP28),
     +            D(LFP29),D(LFP30),D(LFP31),D(LFP34),D(LFP35),
     +            D(LFP35+NQ*NNUC),D(LFP35+2*NQ*NNUC),
     +            D(LFP43),D(LFP43),MAXD,LAST,INEL)
C determine length needed for macroscopic xs and mixing
      NW = 0
      DO 90  IM=1,MEDIA
         NM = 0
         LZ = 0
         DO 70 IN=1,NMIX
            IF(LD(LFP10+IN-1).NE.IM) GOTO 70
            NM = NM+1
            II = LD(LFP16+IN-1)
            LZ = MAX0(LD(LFP27+NNR*(II-1)),LZ)
C           LZ = MAX0(LDICT(1,II),LZ)
   70    CONTINUE
         IF(NM.GT.1) LZ = 4*LZ
         DO 80 J=1,NMIX
            IF(LD(LFP10+J-1).NE.IM) GOTO 80
            II = LD(LFP16+J-1)
   80    CONTINUE
         NW = NW + LZ
   90 CONTINUE
      NW = NW + 2
      NWTOT = NWTOT + NW
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX3,0,2,'MOX3',0,0,NW,0,-1)
      LAST = LMOX3 + 1
      LFP44=LAST+1
      MAXD = LMOX3+NW
C       SET, MIX AND THIN THE TOTAL CROSS SECTIONS
C       ACCORDING TO THE MIXING TABLE
      CALL XSECN3(D(LFP10),D(LFP11),D(LFP12),D(LFP16),D(LFP26),
     +            D(LFP27),D(LFP32),D(LFP33),D(LFP44),D(LFP44),
     +            D,MAXD,LAST)
C       ESTABLISH THE PHOTON TOTAL CROSS SECTION DATA DICTIONARY
C       STORAGE LOCATIONS
C determine number of words needed for photon production xs
      NW = 0
      DO 110 I=1,NNUC
         DO 100 J=1,LD(LFP28+I-1)
            LZ = LD(LFP31 + 2*J - 1 + NGR*(I-1))
C           LZ = LGCB(2*J,I)
            NW = NW + LZ
  100    CONTINUE
  110 CONTINUE
      NW = NW + 2*NGR*NNUC+2
      NWTOT = NWTOT + NW + 1
      CALL CHKZEB(NW,IXCONS)
      CALL MZBOOK(IXCONS,LMOX4,0,2,'MOX4',0,0,NW,0,-1)
      LMAG2 = LMOX4 + 1
      LD(LMAG2) = NMAGIC
      LFP45 = LMAG2 + 1
      LFP46 = LFP45 + NGR*NNUC
      LFP47 = LFP46 + NGR*NNUC
      LAST = LFP47 - 1
      MAXD = LMOX4 + NW
C       CLEAR THE STORAGE LOCATIONS FOR THE PHOTON DICTIONARIES
C       OF THE TOTAL PHOTON PRODUCTION CROSS SECTIONS
      CALL CLEAR(D,LFP45,LFP47-1)
C       SUM THE PHOTON PARTIAL DISTRIBUTIONS OF THE ENDF/B-V
C       FILE 12 AND FILE 13 DATA (BY MT NUMBER) AND PLACE THESE
C       MICROSCOPIC MULTIPLICITIES TIMES CROSS SECTIONS IN CORE
      CALL XSECN5(D(LFP28),D(LFP30),D(LFP31),D(LFP45),D(LFP46),
     +           D(LFP47),D(LFP47),D,D,MAXD,LAST)
C
C print out media to print unit IOUT
C      WRITE(IOUT,10000)
10100 FORMAT(23X,'MICAP Material Parameters',/,
     +       23X,'-------------------------',/)
      WRITE(IOUT,10200)
10200 FORMAT(8X,'GEANT Material Parameters',10X,
     +        6X,'MICAP Material Parameters',/,
     +       8X,25('-'),10X,6X,25('-'))
      WRITE(IOUT,10300)
10300 FORMAT(1X,'Material',16X,'No/Iso',4X,'A',5X,'Z',2X,'|',
     +        4X,'A',5X,'Z',3X,'Density',
     +        3X,'Coll.Len',/,44('-'),'+',33('-'))
      MFLAG = 0
      KMED  = 0
      NISO  = 1
      DO 130 I=0,NMIX-1
C get GEANT name of material
         MARK = '/   '
         IF(LD(LFP11+I)/1000.NE.LD(LFP13+I)) THEN
            MARK = '/  *'
            MFLAG=1
         ENDIF
         K1 = LD(LFP16+I)-1
         LS1 = LD(LFP26+NNR*K1)+LMOX2
         LEN = LD(LFP27+NNR*K1)/2
         EN = 1.E6
         CALL TBSPLT(D(LS1),EN,LEN,XSEC)
         XSEC = 1./XSEC/D(LFP12+I)
         IF(LD(LFP140+I).NE.0.) THEN
            WRITE(CGEANT,'(F6.1,I5)')  D(LFP140+I),LD(LFP13+I)
         ELSE
            WRITE(CGEANT,'(A11)')  '    -     -'
         ENDIF
         IF(KMED.NE.LD(LFP10+I)) THEN
          NISO = 1
          CALL G3FMATE(LD(LGE2MO+LD(LFP10+I)),MATNAM,AA,ZZ,DENS,
     +       RADL,ABSL,UB,NW)
          NBLK = LNBLNK(MATNAM)
          DO 120 JC=NBLK+1,20
             WRITE(MATNAM(JC:JC),'(A1)') '.'
  120     CONTINUE
          WRITE(MARK(2:3),'(I2)') NISO
          WRITE(IOUT,10400) MATNAM,LD(LGE2MO+LD(LFP10+I)),MARK,
     +     CGEANT,
     +     D(LFP34+LD(LFP16+I)-1)*1.008665,
     +     LD(LFP11+I)/1000,D(LFP12+I),XSEC
          KMED = LD(LFP10+I)
         ELSE
          WRITE(MARK(2:3),'(I2)') NISO
          WRITE(IOUT,10500) LD(LGE2MO+LD(LFP10+I)),MARK,CGEANT,
     +     D(LFP34+LD(LFP16+I)-1)*1.008665,
     +     LD(LFP11+I)/1000,D(LFP12+I),XSEC
         ENDIF
10400    FORMAT(1X,A20,I6,A4,A11,'  |',F6.1,I5,1X,E11.4,1X,E9.3)
10500    FORMAT(1X,20X,I6,A4,A11,'  |',F6.1,I5,1X,E11.4,1X,E9.3)
         LD(LFP13+I) = LD(LFP11+I)/1000
         NISO = NISO + 1
  130 CONTINUE
      WRITE(IOUT,'(78(''-''),/,48X,''Density in (Atoms/barn/cm)'')')
      WRITE(IOUT,'(36X,
     +    ''Collision Length for 1 MeV neutron in (cm)'',/)')
      IF(MFLAG.EQ.1) WRITE(IOUT,'(/,
     + 15X,''*******************************************'',/,
     + 15X,''*               W A R N I N G             *'',/,
     + 15X,''*   Marked isotopes (*) not found in the  *'',/,
     + 15X,''*        cross-section file(s)            *'',/,
     + 15X,''*    Cross-sections of the isotope with   *'',/,
     + 15X,''*    the closest Z will be used instead   *'',/,
     + 15X,''*******************************************'',/)')
C which x-section files have been used?
      LT = LTEMP
      LCI = LCISO
      LC = 0
      NOHED=.TRUE.
  140 CONTINUE
C first check if x-section file has been used!
        NUNIT = IQ(LT+NTUNIT)
        DO 150 I=0,NMIX-1
           KISO = LD(LFP16+I)
           MISO = LD(LFP17+KISO-1)
           IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 160
  150   CONTINUE
C unit never used !
        GOTO 190
  160   CONTINUE
C search for comments for selected isotopes
        NCOM = IQ(LCI+1)
        DO 180 J=1,NCOM
           K = (J-1)*81 + 2
           JZ = IQ(LCI+K)
           JA = IQ(LCI+K+1)
           CCOMM = ' '
           CALL UHTOC(IQ(LCI+K+2),4,CCOMM,70)
           DO 170 I=0,NMIX-1
              KISO = LD(LFP16+I)
              IA = NINT(D(LFP34+KISO-1)*1.008665)
              IZ = LD(LFP11+I)/1000
              MISO = LD(LFP17+KISO-1)
C print the comment, if the isotope is correct and has been read from
C the current x-section file
              IF(IA.EQ.JA .AND. IZ.EQ.JZ .AND.
     +           NUNIT.EQ.LD(LFP18A+MISO-1)) THEN
                IF(NOHED) THEN
                 WRITE(IOUT,'(/,23X,''COMMENTS ABOUT ISOTOPE DATA'')')
                 WRITE(IOUT,'(  23X,''---------------------------'',/)')
                 NOHED = .FALSE.
                ENDIF
                LC = LC + 1
                WRITE(IOUT,'(I4,'') '',A70)') LC,CCOMM
                GOTO 180
              ENDIF
  170      CONTINUE
  180   CONTINUE
  190   LT = LQ(LT)
        LCI = LQ(LCI)
      IF(LT.GT.0.AND.LCI.GT.0) GOTO 140
C print the x-section file names and comments
      WRITE(IOUT,'(/,20X,''USED NEUTRON CROSS-SECTION FILES'')')
      WRITE(IOUT,'(  20X,''--------------------------------'',/)')
      LT = LTEMP
  200 CONTINUE
C first check if x-section file has been used!
        NUNIT = IQ(LT+NTUNIT)
        DO 210 I=0,NMIX-1
           KISO = LD(LFP16+I)
           MISO = LD(LFP17+KISO-1)
           IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 220
  210   CONTINUE
C unit never used !
        GOTO 230
  220   CONTINUE
C get file name of x-section file
        XSFILE = ' '
        COMMEN = ' '
        DATSTR = ' '
        CALL UHTOC(IQ(LT+NTNAME+1),4,XSFILE,IQ(LT+NTNAME))
        CALL UHTOC(IQ(LT+NTCOMM+1),4,COMMEN,IQ(LT+NTCOMM))
        CALL UHTOC(IQ(LT+NTDATS+1),4,DATSTR,IQ(LT+NTDATS))
        WRITE(IOUT,'('' File      : '',A66)') XSFILE
        WRITE(IOUT,'('' Generated : '',A24,/,
     +               '' Comment   : '',A66,/)') DATSTR,COMMEN
  230   LT = LQ(LT)
      IF(LT.GT.0) GOTO 200
      WRITE(IOUT,'(/,'' MICAP :'',I10,
     + '' words used in GCBANK for neutron x-section tables''/)') NWTOT
      RETURN
      END
